home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib07.dsk / TURTLE GRAPHICS.bas < prev    next >
BASIC Source File  |  2023-02-26  |  9KB  |  232 lines
  1. 20  LOMEM: 16400: TEXT : HOME : GOSUB 2800: HGR : GOSUB 800
  2. 40  HOME :FC = FC +1: IF FC = 25  THEN FC =  FRE(1):FC = 0
  3. 45  VTAB 22: INPUT "WHAT DO YOU WANT THE TURTLE TO DO?      ";IN$
  4. 50 BP = 0:VC = 0:IV = 0:IC = 0:C = 0: ONERR  GOTO 285
  5. 60  IF IN$ = ""  THEN 40
  6. 70  IF  RIGHT$(IN$,1) = "."  THEN IN$ =  LEFT$(IN$,( LEN(IN$) -1))
  7. 80 I$ =  LEFT$(IN$,2)
  8. 90 KY =  PEEK( -16384): IF KY >127  THEN  POKE  -16368,0: GOTO 40
  9. 100  IF I$ = "FD"  THEN  GOSUB 400: GOSUB 500: GOTO 300
  10. 110  IF I$ = "BK"  THEN B = 1: GOSUB 400: GOSUB 500: GOTO 300
  11. 120  IF I$ = "RT"  THEN  GOSUB 400: GOSUB 600: GOTO 300
  12. 130  IF I$ = "LT"  THEN LE = 1: GOSUB 400: GOSUB 600: GOTO 300
  13. 140  IF  LEFT$(IN$,1) = ">"  THEN 1100
  14. 150  IF I$ = "DO"  THEN 1300
  15. 160  IF I$ = "//"  THEN D(C) = D(C) -1: GOTO 1470
  16. 170  IF I$ = "PU"  THEN DR = 0: GOTO 300
  17. 180  IF I$ = "PD"  THEN DR = 1: GOTO 300
  18. 190  IF I$ = "NT"  THEN T = 1: GOSUB 700: GOTO 300
  19. 200  IF I$ = "TU"  THEN T = 0: GOSUB 800: GOTO 300
  20. 210  IF I$ = "HO"  THEN  GOSUB 1600: GOTO 300
  21. 220  IF I$ = "CL"  THEN  GOSUB 1700: GOTO 40
  22. 230  IF I$ = "FI"  THEN 2000
  23. 240  IF I$ = "ED"  THEN 1800
  24. 250  IF I$ = "QU"  THEN  TEXT : HOME : END 
  25. 260  IF I$ = "IN"  THEN IG = 1: GOSUB 400: GOTO 300
  26. 270  IF BP = 1  THEN ED$ = PI$(PI): TEXT : HOME : GOTO 1900
  27. 280  HOME : VTAB 22: PRINT "I DON'T UNDERSTAND ";IN$: GOSUB 2700: GOTO 40
  28. 285  CALL 807: GOTO 280
  29. 299  REM  * PARSE INSTRUCTIONS *
  30. 300  FOR J = 1 TO ( LEN(IN$) -1)
  31. 310  IF  MID$ (IN$,J,1) = "."  THEN IN$ =  RIGHT$(IN$,( LEN(IN$) -J)): GOTO 60
  32. 320  NEXT J
  33. 330  GOTO 40
  34. 399  REM  * DETERMINE QUANTITY *
  35. 400  FOR J = 1 TO  LEN(IN$)
  36. 410  IF  MID$ (IN$,J,1) = "."  THEN QU =  VAL( MID$ (IN$,3,J -3)): GOTO 440
  37. 420  NEXT J
  38. 430 QU =  VAL( MID$ (IN$,3))
  39. 440  IF QU = 0  THEN  GOSUB 1500: GOTO 460
  40. 450  IF IG = 1  THEN IC = IC +1:IV = QU:IG = 0
  41. 460  RETURN 
  42. 499  REM  * MOVE TURTLE *
  43. 500  GOSUB 700
  44. 510  IF B = 1  THEN TU = 180 +TU
  45. 520 X1 = X + SIN(TU *CV) *QU +.00005:Y1 = Y - COS(TU *CV) *QU +.00005
  46. 530  IF X1 <9  OR Y1 <9  OR X1 >270  OR Y1 >139  THEN 580
  47. 540  IF DR = 0  THEN 555
  48. 550  HPLOT X,Y TO X1,Y1
  49. 555  IF B = 1  THEN TU = TU -180
  50. 560 B = 0:X = X1:Y = Y1
  51. 570  GOSUB 800: RETURN 
  52. 580  HOME : VTAB 22: PRINT "THE TURTLE WOULD BE OUT OF BOUNDS.      TRY A DIFFERENT MOVE.                  ": GOSUB 2700:X1 = X:Y1 = Y: IF B = 1  THEN B = 0:TU = TU -180
  53. 590  POP : GOSUB 800: GOTO 40
  54. 599  REM   * TURN TURTLE *
  55. 600  GOSUB 700
  56. 610  IF LE = 1  THEN QU = 360 -QU:LE = 0
  57. 620  IF  ABS(QU) >360  THEN QU =  INT((QU/360 - INT(QU/360)) *360.05) * SGN(QU)
  58. 630 TU = TU +QU: GOSUB 800: RETURN 
  59. 699  REM  * ERASE TURTLE *
  60. 700  IF T > = 1  THEN T = T +1: IF T >2  THEN  RETURN 
  61. 710  HCOLOR= 0
  62. 720  HPLOT X2,Y2: HPLOT X3,Y3: HPLOT X4,Y4: HPLOT X5,Y5: HPLOT X6,Y6
  63. 730  HCOLOR= 3
  64. 740  RETURN 
  65. 799  REM  * DRAW TURTLE *
  66. 800  IF T >1  THEN  RETURN 
  67. 810  GOSUB 900: RETURN 
  68. 899  REM  * TURTLE LOCATION *
  69. 900 WI = 6:TA = 7
  70. 910 X2 = X1 -( COS(TU *CV)) *WI:Y2 = Y1 -( SIN(TU *CV)) *WI
  71. 920 X3 = X1 +( SIN(TU *CV)) *TA:Y3 = Y1 -( COS(TU *CV)) *TA
  72. 930 X4 = X1 +( COS(TU *CV)) *WI:Y4 = Y1 +( SIN(TU *CV)) *WI
  73. 940 X5 = X2 +((X3 -X2)/2):Y5 = Y2 +((Y3 -Y2)/2)
  74. 950 X6 = X3 -((X3 -X4)/2):Y6 = Y3 -((Y3 -Y4)/2)
  75. 960  & BT = X2,Y2: & CT = X3,Y3: & DT = X4,Y4: & ET = X5,Y5: & FT = X6,Y6
  76. 970  IF BT = 1  THEN Y2 = 170
  77. 980  IF CT = 1  THEN Y3 = 170
  78. 990  IF DT = 1  THEN Y4 = 170
  79. 1000  IF ET = 1  THEN Y5 = 170
  80. 1010  IF FT = 1  THEN Y6 = 170
  81. 1020  HPLOT X2,Y2: HPLOT X3,Y3: HPLOT X4,Y4: HPLOT X5,Y5: HPLOT X6,Y6: RETURN 
  82. 1099  REM  * CHECK FOR PICTURE *
  83. 1100 PI = PI +1
  84. 1120  FOR J = 1 TO ( LEN(IN$) -1)
  85. 1130  IF  MID$ (IN$,J,1) = "."  THEN PI$(PI) =  LEFT$(IN$,J -1):IN$ =  RIGHT$(IN$,( LEN(IN$) -J)): GOTO 1160
  86. 1140  NEXT J
  87. 1150 PI$(PI) = IN$:IN$ = ""
  88. 1160  FOR I = 0 TO (PI -1)
  89. 1170  IF PI$(I) = PI$(PI)  THEN IN$ = FI$(I) +"." +IN$:PI = PI -1: GOTO 60
  90. 1180  NEXT I
  91. 1190  HOME : VTAB 22: PRINT "I DON'T KNOW HOW TO ";PI$(PI): PRINT : PRINT "PLEASE TELL ME HOW"
  92. 1200  GOSUB 2700
  93. 1210  HOME : VTAB 22: PRINT "TO ";PI$(PI);: INPUT " ";FI$(PI)
  94. 1220 IN$ = FI$(PI) +"." +IN$:BP = 1: GOTO 60
  95. 1299  REM  * REPEAT FUNC. (DO) *
  96. 1300 C = C +1
  97. 1310  FOR J = 1 TO  LEN(IN$)
  98. 1320  IF  MID$ (IN$,J,1) = "("  THEN 1350
  99. 1330  NEXT J
  100. 1340 C = C -1: GOTO 280
  101. 1350  FOR L =  LEN(IN$) TO 1  STEP  -1
  102. 1360  IF  MID$ (IN$,L,1) = ")"  THEN 1390
  103. 1370  NEXT L
  104. 1380 C = C -1: GOTO 280
  105. 1390  FOR L1 = J TO L
  106. 1400  IF  MID$ (IN$,L1,1) = ")"  THEN 1420
  107. 1410  NEXT L1
  108. 1420  IF L1 <L  THEN L = L1
  109. 1430 SA$(C) =  MID$ (IN$,J +1,L -J -1)
  110. 1440  IF L < LEN(IN$)  THEN SB$(C) =  MID$ (IN$,L +2): GOTO 1450
  111. 1445 SB$(C) = ""
  112. 1450 D(C) =  VAL( MID$ (IN$,3,J -3))
  113. 1460 IN$ = SA$(C) +".//": GOTO 60
  114. 1470  IF D(C) = 0  AND SB$(C) = ""  THEN C = 0: GOTO 40
  115. 1480  IF D(C) = 0  THEN IN$ = SB$(C):SB$(C) = "":C = C -1: GOTO 60
  116. 1490 IN$ = SA$(C) +".//": GOTO 60
  117. 1499  REM  * VARIABLE FUNCTION *
  118. 1500 VC = VC +1
  119. 1510 VA$(VC) =  MID$ (IN$,3,J -3)
  120. 1520  FOR L = 0 TO VC -1
  121. 1530  IF VA$(L) = VA$(VC)  THEN QU = VA(L) +IV *IC:VC = VC -1: GOTO 460
  122. 1540  NEXT L
  123. 1550  HOME : VTAB 22: PRINT "WHAT IS THE VALUE OF ";VA$(VC);: INPUT VA(VC)
  124. 1560 QU = VA(VC): RETURN 
  125. 1599  REM  * HOME *
  126. 1600  GOSUB 700:X = X1:Y = Y1:X1 = 139:Y1 = 79
  127. 1610  IF DR = 0  THEN 1630
  128. 1620  HPLOT X,Y TO X1,Y1
  129. 1630 TU = 0:X = X1:Y = Y1: GOSUB 800: RETURN 
  130. 1699  REM  * CLEAR (CL) *
  131. 1700  HGR :X = 139:Y = 79:X1 = X:Y1 = Y
  132. 1710 TU = 0:T = 0:DR = 1: GOSUB 800: RETURN 
  133. 1799  REM  * PICTURE EDITOR *
  134. 1800  TEXT : HOME 
  135. 1810  FOR J = 1 TO  LEN(IN$)
  136. 1820  IF  MID$ (IN$,J,1) = ">"  THEN 1850
  137. 1830  NEXT J
  138. 1840  GOTO 280
  139. 1850 ED$ =  MID$ (IN$,J)
  140. 1860  FOR I = 1 TO PI
  141. 1870  IF PI$(I) = ED$  THEN  HOME : GOTO 1900
  142. 1880  NEXT I
  143. 1890 IN$ = ED$: GOTO 1100
  144. 1900  INVERSE : PRINT : HTAB 10: PRINT "*  PICTURE EDITOR  *": NORMAL 
  145. 1910  PRINT : PRINT : INVERSE : PRINT "EDITING:";: NORMAL : PRINT ED$
  146. 1920  PRINT : INVERSE : PRINT "THE INSTRUCTIONS FOR THIS PICTURE ARE:": NORMAL 
  147. 1930  PRINT : PRINT FI$(I)
  148. 1940  INVERSE : VTAB 15: PRINT "WHAT SHOULD THEY BE?": NORMAL 
  149. 1950  VTAB 17: HTAB 2: PRINT FI$(I)
  150. 1960  VTAB 17: INPUT FI$(I)
  151. 1970 IN$ = "CL": GOTO 50
  152. 1999  REM  * FILING SYSTEM *
  153. 2000  TEXT : HOME :D$ =  CHR$(4): ONERR  GOTO 2640
  154. 2010  VTAB 5: PRINT "OPTIONS AVAILABLE:                                                                  <1> SAVE PICTURES TO A FILE             <2> RETRIEVE PICTURES FROM A FILE       <3> DELETE A FILE"
  155. 2020  PRINT "    <4> CATALOG AND INDEX FILES             <5> RETURN TO GRAPHICS MODE
  156. 2030  VTAB 22: PRINT  SPC( 40): VTAB 22: INPUT "TYPE THE NUMBER OF YOUR CHOICE. ";OP$:OP =  VAL(OP$)
  157. 2040  IF OP <1  OR OP >5  THEN 2030
  158. 2050  ON OP GOTO 2060,2190,2320,2380,2630
  159. 2060  IF PI = 0  THEN  HOME : VTAB 12: PRINT "THERE ARE NO PICTURES TO SAVE": GOSUB 2700: GOTO 2000
  160. 2070  GOSUB 2620
  161. 2080  HOME : VTAB 12: HTAB 15: FLASH : PRINT "SAVING": NORMAL 
  162. 2090  PRINT D$;"OPEN ";NA$
  163. 2100  PRINT D$;"DELETE ";NA$
  164. 2110  PRINT D$;"OPEN ";NA$
  165. 2120  PRINT D$;"WRITE ";NA$
  166. 2130  PRINT PI
  167. 2140  FOR I = 1 TO PI
  168. 2150  PRINT PI$(I): PRINT FI$(I)
  169. 2160  NEXT I
  170. 2170  PRINT D$;"CLOSE ";NA$
  171. 2180  GOTO 2000
  172. 2190  HOME : VTAB 5: INVERSE : PRINT "WARNING:": NORMAL 
  173. 2200  PRINT "RETRIEVING A FILE WILL DESTROY ANY      PICTURES YOU CURRENTLY HAVE IN MEMORY."
  174. 2210  PRINT : PRINT "IF YOU WISH TO CONTINUE, PRESS 'C'      PRESS ANY OTHER KEY TO RETURN TO FILE   ACCESS OPTIONS."
  175. 2220  INPUT K$
  176. 2230  IF K$ < >"C"  THEN 2000
  177. 2240  GOSUB 2620
  178. 2250  HOME : FLASH : VTAB 12: HTAB 14: PRINT "RETRIEVING": NORMAL 
  179. 2260  GOSUB 2500
  180. 2270 PI = NU
  181. 2280  FOR I = 1 TO PI
  182. 2290 PI$(I) = PX$(I):FI$(I) = FX$(I)
  183. 2300  NEXT I
  184. 2310  GOTO 2000
  185. 2320  GOSUB 2620
  186. 2330  PRINT : PRINT : INPUT "ARE YOU SURE? ";K$
  187. 2340  IF  LEFT$(K$,1) < >"Y"  THEN 2000
  188. 2350  HOME : FLASH : VTAB 12: HTAB 14: PRINT " DELETING ": NORMAL 
  189. 2360  PRINT D$;"DELETE ";NA$
  190. 2370  GOTO 2000
  191. 2380  HOME : PRINT "YOUR FILE ENTRIES ARE PRECEDED BY A "; CHR$(34);"T"; CHR$(34)
  192. 2390  PRINT D$;"CATALOG"
  193. 2400  PRINT : INVERSE : INPUT "DO YOU WANT TO SEE WHICH DRAWINGS ARE IN A CERTAIN FILE? ";K$: NORMAL 
  194. 2410  IF  LEFT$(K$,1) < >"Y"  THEN 2000
  195. 2420  GOSUB 2620
  196. 2430  HOME : VTAB 12: HTAB 14: FLASH : PRINT " SEARCHING ": NORMAL 
  197. 2440  GOSUB 2500
  198. 2450  HOME : FOR L = 1 TO NU
  199. 2460  PRINT PX$(L);": ";FX$(L)
  200. 2470  GOSUB 2600: PRINT 
  201. 2480  NEXT L
  202. 2490  GOSUB 2590: GOTO 2000
  203. 2500  PRINT D$;"OPEN ";NA$
  204. 2510  PRINT D$;"READ ";NA$
  205. 2520  INPUT NU
  206. 2530  FOR I = 1 TO NU
  207. 2540  INPUT PX$(I): INPUT FX$(I)
  208. 2550  NEXT I
  209. 2560  PRINT D$;"CLOSE ";NA$
  210. 2570  RETURN 
  211. 2580  GOSUB 2590: GOTO 2000
  212. 2590  VTAB 24: HTAB 5: INVERSE : PRINT "PRESS ANY KEY TO CONTINUE";: NORMAL 
  213. 2600  GET K$: IF K$ = ""  THEN 2600
  214. 2610  RETURN 
  215. 2620  HOME : VTAB 12: INPUT "FILE NAME? ";NA$: RETURN 
  216. 2630 IN$ = "CL": GOTO 60
  217. 2640  CALL 807: IF  PEEK(222) = 5  THEN  PRINT D$;"DELETE ";NA$
  218. 2650  HOME : VTAB 12: PRINT "CHECK YOUR FILE NAME AND TRY AGAIN.": GOSUB 2700: GOTO 2000
  219. 2699  REM  * TIME DELAY *
  220. 2700  FOR H = 1 TO 1000: NEXT H: RETURN 
  221. 2799  REM  * SET UP VARIABLES *
  222. 2800 TU = 0:X = 139:Y = 79:CV = 3.14159265/180:DR = 1: HCOLOR= 3
  223. 2810  DIM PI$(100): DIM FI$(100):PI = 0: DIM PX$(100): DIM FX$(100)
  224. 2820  POKE  -16301,0
  225. 2830  FOR J = 768 TO 816: READ K: POKE J,K: NEXT J
  226. 2840  DATA   32,227,223,133,133,132,134,169,208,32
  227. 2850  DATA   192,222,165,18,72,165,17,72,32,185
  228. 2860  DATA   246,32,17,244,165,48,49,38,240,2 
  229. 2870  DATA   169,1,168,32,1,227,76,91,218 
  230. 2875  DATA  104,168,104,166,223,154,72,152,72,96: REM  ERROR TRAP SUBROUTINE FROM P.82 OF APPLESOFT MANUAL.  STARTS AT 807
  231. 2880  POKE 1013,76: POKE 1014,0: POKE 1015,3
  232. 2890 X1 = X:Y1 = Y: RETURN